home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / DIRS.SWG / 0003_DOS Wildcards.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  6.4 KB  |  193 lines
  1. {
  2. JH>Is anybody familiar with a way to do Wildcards?
  3. JH>I want to be able to select
  4. JH>something ie: *.ZIP and it makes a que list from all of them?
  5.  
  6. If you ever need a procedure to check whether a file conforms to a wildcard
  7. Ive got just the right procedure for you.
  8.  
  9. _______________0/__________________________________________
  10.                0\                                           }
  11.  
  12. Function DirOnly(FileName:PathStr) : DirStr;
  13.         Var
  14.                 Dir  : DirStr;
  15.                 Name : NameStr;
  16.                 Ext  : ExtStr;
  17.         Begin
  18.                 FSplit(FileName,Dir,Name,Ext);
  19.                 DirOnly := Dir;
  20.         End;
  21.  
  22. Function NameOnly(FileName:PathStr) : TStr12;
  23.         Var
  24.                 Dir  : DirStr;
  25.                 Name : NameStr;
  26.                 Ext  : ExtStr;
  27.         Begin
  28.                 FSplit(FileName,Dir,Name,Ext);
  29.                 NameOnly := Name+Ext;
  30.         End;
  31.  
  32. Function BaseNameOnly(FileName:PathStr) : NameStr;
  33.         Var
  34.                 Dir  : DirStr;
  35.                 Name : NameStr;
  36.                 Ext  : ExtStr;
  37.         Begin
  38.                 FSplit(FileName,Dir,Name,Ext);
  39.                 BaseNameOnly := Name;
  40.         End;
  41.  
  42. Function ExtOnly(FileName:PathStr) : ExtStr;
  43.         Var
  44.                 Dir  : DirStr;
  45.                 Name : NameStr;
  46.                 Ext  : ExtStr;
  47.         Begin
  48.                 FSplit(FileName, Dir, Name, Ext);
  49.                 If Pos('.',Ext) <> 0 Then Delete(Ext,1,1);
  50.                 ExtOnly := Ext;
  51.         End;
  52.  
  53. Function SameName(N1,N2:NameStr) : Boolean;
  54.         Var
  55.                 P1,P2 : Byte;
  56.                 Match : Boolean;
  57.         Begin
  58.                 P1    := 1;
  59.                 P2    := 1;
  60.                 Match := True;
  61.  
  62.                 If (Length(N1) = 0) And (Length(N2) = 0) Then
  63.                         Match := True
  64.                 Else
  65.                         If Length(N1) = 0 Then
  66.                                 If N2[1] = '*' Then
  67.                                         Match := True
  68.                                 Else
  69.                                         Match := False
  70.                         Else
  71.                                 If Length(N2) = 0 Then
  72.                                         If N1[1] = '*' Then
  73.                                                 Match := True
  74.                                         Else
  75.                                                 Match := False;
  76.  
  77.                 While (Match = True) And (P1 <= Length(N1)) And (P2 <= 
  78. Length(N2)) Do
  79.                         If (N1[P1] = '?') Or (N2[P2] = '?') Then
  80.                                 Begin
  81.                                         Inc(P1);
  82.                                         Inc(P2);
  83.                                 End
  84.                         Else
  85.                                 If N1[P1] = '*' Then
  86.                                         Begin
  87.                                                 Inc(P1);
  88.                                                 If P1 <= Length(N1) Then
  89.                                                 Begin
  90.                                                 While (P2 <= Length(N2)) And
  91.                                                 Not SameName(Copy(N1,P1,Length(N1)-P1+1),Copy(N2,P2,Length(N2)-P2+1)) Do
  92.                                                 Inc(P2);
  93.                                                 If P2 > Length(N2) Then Match := False
  94.                                                 Else
  95.  
  96. Begin
  97.  
  98.         P1 := Succ(Length(N1));
  99.  
  100.         P2 := Succ(Length(N2));
  101.  
  102. End;
  103.                    End
  104.                      Else
  105.                      P2 := Succ(Length(N2));
  106.                      End
  107.                       Else
  108.                       If N2[P2] = '*' Then
  109.                               Begin
  110.                                       Inc(P2);
  111.                                       If P2 <= Length(N2) Then
  112.                                               Begin
  113.  
  114. While (P1 <= Length(N1)) And
  115.  
  116.            Not SameName(Copy(N1,P1,Length(N1)-P1+1),Copy(N2,P2,Length(N2)-P2+1)) Do
  117.  
  118.         Inc(P1);
  119.         If P1 > Length(N1) Then
  120.  
  121.         Match := False
  122.  
  123. Else
  124.  
  125.         Begin
  126.  
  127.                 P1 := Succ(Length(N1));
  128.  
  129.                 P2 := Succ(Length(N2));
  130.  
  131.         End;
  132.                           End
  133.                           Else
  134.                           P1 := Succ(Length(N1));
  135.                     End
  136.             Else
  137.             If UpCase(N1[P1]) = UpCase(N2[P2]) Then
  138.                             Begin
  139.                                     Inc(P1);
  140.                                     Inc(P2);
  141.                             End
  142.                     Else
  143.                             Match := False;
  144.  
  145.                 If P1 > Length(N1) Then
  146.                         Begin
  147.                                 While (P2 <= Length(N2)) And (N2[P2] = '*') 
  148. Do
  149.                                         Inc(P2);
  150.                                 If P2 <= Length(N2) Then
  151.                                         Match := FALSE;
  152.                         End;
  153.  
  154.                 If P2 > Length(N2) Then
  155.                         Begin
  156.                                 While (P1 <= Length(N1)) And (N1[P1] = '*')
  157. Do
  158.                                         Inc(P1);
  159.                                 If P1 <= Length(N1) Then
  160.                                         Match := False;
  161.                         End;
  162.  
  163.                 SameName := Match;
  164.         End;
  165.  
  166. Function SameFile(File1,File2:PathStr) : Boolean;
  167.         Var
  168.                 Dir1,Dir2 : DirStr;
  169.         Begin
  170.                 File1 := FExpand(File1);
  171.                 File2 := FExpand(File2);
  172.                 Dir1  := DirOnly(File1);
  173.                 Dir2  := DirOnly(File2);
  174.  
  175.                 SameFile :=  SameName(BaseNameOnly(File1),BaseNameOnly(File2)) And
  176.                 SameName(ExtOnly(File1),ExtOnly(File2)) And
  177.                                         (Dir1 = Dir2);
  178.         End;
  179.  
  180. _______________0/__________________________________________
  181.                0\ 
  182.  
  183. Sorry about the bad formatting but I use LONG lines with tabs for all my 
  184. indents with my tab size set to 4. This procedure handles all cases of 
  185. wildcards including some that dos doeen't:
  186.  
  187.     SameFile('*.PAS','HELLO.PAS) = TRUE
  188.     SameFile('*.P?L','HELLO.PAL) = TRUE    
  189.     SameFile('TE*.PAS','TOTO.PAS') = False
  190.     SameFile('*PA.EXE','SUPA.EXE') = True (Not handled by dos!)
  191.     SameFile('ST?P.*','STOP.COM') = True
  192.  
  193.